home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / ngclon11.zip / NG_CLONE.PAS < prev    next >
Pascal/Delphi Source File  |  1990-02-21  |  50KB  |  1,510 lines
  1. {$M 4096,0,0}                 {Reduce stack and heap}
  2. {$R-,I-}                      {Cut off range and I/O checking}
  3.   
  4. program ng_clone;
  5. {After all, that's what it is; Thank you, Mr. Norton, you are among my heroes!}
  6.   
  7. uses    crt,tesstp5;
  8. {TESS version MUST match compiler version}
  9.   
  10. type
  11.   
  12.   gentry=record         {General entry type}
  13.     filptr:longint;
  14.     name:string[40];
  15.   end;
  16.   
  17.   textel= record        {Text-mode screen element}
  18.     cha:byte;
  19.     att:byte;
  20.   end;
  21.   
  22.   fiftylinebuf= array[1..50,1..80] of textel;   {Video buffer types}
  23.   twelwebuf=    array[1..12,1..80] of textel;
  24.   savedline=    array[1..80] of textel;
  25.   
  26. var
  27.   screen:fiftylinebuf absolute $B800:$0000;     {Text-mode screen,     }
  28.                                                 {should be B000:0000h  }
  29.                                                 {on monochrome         }
  30.   csr:word absolute $0040:$0060;                {Low-memory cursor info}
  31.   screenmode:word absolute $0040:$0049;         {Low-memory screen info}
  32.   numrows:word absolute $0040:$0084;            {Low-memory screen info}
  33.   savedscreen:fiftylinebuf;                     {Buffer save current screen on entry}
  34.   smallscreen:twelwebuf;                        {Buffer holds screen template}
  35.   menuline:array[0..1] of savedline;            {Buffer screen template}
  36.   largescreen:array[0..1] of savedline;         {Buffer screen template}
  37.   scrollbuffer:array[0..511] of string[84];     {Buffer guide text entry}
  38.   infobuffer:array[0..511] of longint;          {Buffer guide file info}
  39.   seealso:array[0..19] of gentry;               {Buffer guide file info}
  40.   menu:array[0..2] of string[9]; {Buffer to hold static part of guide menu structure}
  41.   mennu:array[0..3,0..8] of gentry;  {Buffer to hold variable part of guide menu structure}
  42.   backstack:array[0..3] of byte;                {TESS background stack}
  43.   itemlist:array[0..3] of byte;                 {Menu structure info}
  44.   menuplaces,menulengths:array[0..6] of byte;   {Stacks for nested menu structures}
  45.   errorinfo:array[3..6] of string[14];          {Buffer for error messages}
  46.   f:file;                                                                                    {The guide file}
  47.   propath,homedir,streng:string;                {String variables, mostly for path and file use}
  48.   tsrstring:string[8];                          {TESS ID string}
  49.   parent:array[0..3] of longint;                {Stack for nested menu structures}
  50.   poffset:array[0..3] of word;                  {Stack for nested menu structures}
  51.   pcurpos:array[0..3] of byte;                  {Stack for nested menu structures}
  52.   defptr,stackptr:pointer;                      {TESS pointers}
  53.   previous,next:longint;                        {Previous and next entry}
  54.   idnum,i,j,offset,ch,id,bufferlength,savedcsr:word;        {Word variables}
  55.   erro,wix,wiy,curpos,entrytype,seealsonum,sapos,level,scrtypeflag,startline,
  56.   txtattri,
  57. Normal_Text,
  58. UnderScore,
  59. Bold_Face,
  60. Select_Cursor,
  61. Menu_Text,
  62. mlevel,xchoice,ychoice,menux,menuy,menuantal,menunr:byte;        {Byte variables}
  63.   
  64. procedure hidecrsr; {Make cursor invisible on CGA,EGA or VGA}
  65. begin
  66.   inline($B4/$01/$B5/$20/$CD/$10);
  67. end;
  68.   
  69. function restorecrsr(crsr:word):boolean;
  70.   {Restore saved cursor on CGA,EGA or VGA}
  71.   inline($B4/$01/$59/$CD/$10);
  72.   
  73.   function key:word;                                                                    {Keyboard interrupt}
  74.     inline($CD/$16);
  75.   
  76.     procedure keyread(var karakter:word);
  77.     {Readkey replacement}
  78.       var tch:char;
  79.     begin
  80.       karakter:=key;
  81.       if (lo(karakter)=0) then {If extended key, add 256 to value of key code}
  82.         begin
  83.           tch:=char(hi(karakter));
  84.           karakter:=ord(tch)+256;
  85.         end
  86.       else {Else return key code as is}
  87.         begin
  88.           tch:=char(lo(karakter));
  89.           karakter:=ord(tch);
  90.         end;
  91.     end;
  92.   
  93.     procedure writestring(cux,cuy,startattr,change,extra:byte;cus:string);        {Direct screen write}
  94.       var jcount,ycount,tmpchr:byte;
  95.         jch:char;
  96.     begin
  97.       jcount:=0;ycount:=0;txtattri:=startattr;
  98.       repeat
  99.         inc(jcount);
  100.         jch:=cus[jcount];
  101.         if jch<>'^' then       {If not NG control code, write character as is}
  102.           begin
  103.             if jch=#255 then   {Expand spaces}
  104.               begin
  105.                 inc(jcount);
  106.                 jch:=cus[jcount];
  107.                 for ycount:=ycount to ycount+ord(jch) do
  108.                   begin
  109.                     screen[cuy,cux+ycount].cha:=32;
  110.                     screen[cuy,cux+ycount].att:=txtattri;
  111.                   end;
  112.               end
  113.             else
  114.               begin
  115.                 screen[cuy,cux+ycount].cha:=ord(jch);
  116.                 screen[cuy,cux+ycount].att:=txtattri;
  117.                 inc(ycount);
  118.               end;
  119.           end
  120.         else                                                                            {Control code found!}
  121.           begin
  122.             inc(jcount);
  123.             jch:=cus[jcount];
  124.             if ((jch='A') or (jch='a')) then    {Color attribute command}
  125.               begin
  126.                 inc(jcount);
  127.                 jch:=cus[jcount];
  128.                 if change=1 then
  129.                   begin
  130.                     if ((ord(jch)>47) and (ord(jch)<58)) then txtattri:=ord(jch)-48 else
  131.                       if ((ord(jch)>64) and (ord(jch)<71)) then txtattri:=ord(jch)-55;
  132.                     txtattri:=16*txtattri;
  133.                   end;
  134.                 inc(jcount);
  135.                 jch:=cus[jcount];
  136.                 if change=1 then
  137.                   begin
  138.                     if ((ord(jch)>47) and (ord(jch)<58)) then txtattri:=txtattri+ord(jch)-48 else
  139.                       if ((ord(jch)>64) and (ord(jch)<71)) then txtattri:=txtattri+ord(jch)-55;
  140.                   end;
  141.               end
  142.             else if ((jch='C') or (jch='c')) then        {Difficult character}
  143.               begin
  144.                 inc(jcount);
  145.                 jch:=cus[jcount];
  146.                 if ((ord(jch)>47) and (ord(jch)<58)) then tmpchr:=ord(jch)-48 else
  147.                   if ((ord(jch)>64) and (ord(jch)<71)) then tmpchr:=ord(jch)-55;
  148.                 tmpchr:=16*tmpchr;
  149.                 inc(jcount);
  150.                 jch:=cus[jcount];
  151.                 if ((ord(jch)>47) and (ord(jch)<58)) then tmpchr:=tmpchr+ord(jch)-48 else
  152.                   if ((ord(jch)>64) and (ord(jch)<71)) then tmpchr:=tmpchr+ord(jch)-55;
  153.                 screen[cuy,cux+ycount].cha:=tmpchr;
  154.                 screen[cuy,cux+ycount].att:=txtattri;
  155.                 inc(ycount);
  156.               end
  157.             else if ((jch='b') or (jch='B')) then        {Boldface (?)}
  158.               begin
  159.                 if change=1 then
  160.                   begin
  161.                     if txtattri=Normal_Text then txtattri:=Bold_Face else txtattri:=Normal_Text;
  162.                   end;
  163.               end
  164.             else if ((jch='u') or (jch='U')) then        {Underline (?)}
  165.               begin
  166.                 if change=1 then
  167.                   begin
  168.                     if txtattri=Normal_Text then txtattri:=UnderScore else txtattri:=Normal_Text;
  169.                   end;
  170.               end
  171.             else if jch='^' then              {Write control character itself}
  172.               begin
  173.                 screen[cuy,cux+ycount].cha:=ord(jch);
  174.                 screen[cuy,cux+ycount].att:=txtattri;
  175.                 inc(ycount);
  176.               end;
  177.           end;
  178.       until jcount>=length(cus);
  179.       if extra>0 then                           {If desired, fill with blanks}
  180.         begin
  181.           while ycount<extra do
  182.             begin
  183.               screen[cuy,cux+ycount].cha:=32;
  184.               screen[cuy,cux+ycount].att:=txtattri;
  185.               inc(ycount);
  186.             end;
  187.         end;
  188.     end;
  189.   
  190.     procedure threenitvars;                      {Initialize variables}
  191.     begin
  192.       menunr:=0;
  193.       level:=0;
  194.       curpos:=0;
  195.       offset:=0;
  196.       menux:=3;
  197.       menuy:=0;
  198.       mlevel:=0;
  199.       xchoice:=0;
  200.       ychoice:=0;
  201.       sapos:=0;
  202.